home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / NRPAS13.ARJ / PCSHFT.DEM < prev    next >
Text File  |  1991-04-29  |  1KB  |  52 lines
  1. PROGRAM d5r9(input,output);
  2. (* driver for routine PCSHFT *)
  3. LABEL 10,99;
  4. CONST
  5.    nval=40;
  6.    pio2=1.5707963;
  7. TYPE
  8.    glcarray= ARRAY [1..nval] OF real;
  9. VAR
  10.    a,b,poly,x : real;
  11.    i,j,mval : integer;
  12.    c,d : glcarray;
  13.  
  14. FUNCTION func(x: real): real;
  15. BEGIN
  16.    func := sqr(x)*(sqr(x)-2.0)*sin(x)
  17. END;
  18.  
  19. (*$I MODFILE.PAS *)
  20. (*$I CHEBFT.PAS *)
  21.  
  22. (*$I CHEBPC.PAS *)
  23.  
  24. (*$I PCSHFT.PAS *)
  25.  
  26. BEGIN
  27.    a := -pio2;
  28.    b := pio2;
  29.    chebft(a,b,c,nval);
  30. 10:   writeln;
  31.    writeln('How many terms in Chebyshev evaluation?');
  32.    write('Enter n between 6 and ',nval:2,
  33.          '. (n := 0 to end).  ');
  34.    readln(mval);
  35.    IF ((mval <= 0) OR (mval > nval)) THEN GOTO 99;
  36.    chebpc(c,d,mval);
  37.    pcshft(a,b,d,mval);
  38. (* test shifted polynomial *)
  39.    writeln;
  40.    writeln('x':9,'actual':14,'polynomial':14);
  41.    FOR i := -8 to 8 DO BEGIN
  42.       x := i*pio2/10.0;
  43.       poly := d[mval];
  44.       FOR j := mval-1 DOWNTO 1 DO BEGIN
  45.          poly := poly*x+d[j]
  46.       END;
  47.       writeln(x:12:6,func(x):12:6,poly:12:6)
  48.    END;
  49.    GOTO 10;
  50. 99:
  51. END.
  52.